Complete Linux/Complete Linux.iso/docs/devel/tcl/tclx7_31.z/tclx7_31/tcldev/tclX7.3a-p1/tests/filecmds.test

Text File | 1994-01-24 | 5.4 KB | 199 lines

#
# filecmds.test
#
# Tests for the copyfile, pipe, and frename commands.
#---------------------------------------------------------------------------
# Copyright 1992-1993 Karl Lehenbauer and Mark Diekhans.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  Karl Lehenbauer and
# Mark Diekhans make no representations about the suitability of this
# software for any purpose.  It is provided "as is" without express or
# implied warranty.
#------------------------------------------------------------------------------
# $Id: filecmds.test,v 3.3 1994/01/24 04:18:18 markd Exp $
#------------------------------------------------------------------------------
#

if {[info procs test] != "test"} then {source testlib.tcl}

#
# Fork without exec will not work under Tk, skip this test
#
if ![lempty [info commands button]] {
    puts stderr "*************************************************************"
    puts stderr "File commands tests are constructed in a way that does not"
    puts stderr "work under Tk.  Test skipped."
    puts stderr "*************************************************************"
    puts stderr ""
    return
}

# Create a test file

catch {unlink [glob IOTEST*.TMP]}

set testFH [open IOTEST.TMP w]
set testFileSize 0
for {set cnt 0} {$cnt < 100} {incr cnt} {
     set rec [GenRec $cnt]
     puts $testFH $rec
     incr testFileSize [expr [clength $rec]+1]
}
close $testFH

if {$testFileSize != [file size IOTEST.TMP]} {
     error "Wrong file size calculated for IOTEST.TMP"
}

Test filecmds-3.1 {copyfile tests} {
    set testFH [open IOTEST.TMP r]
    set testFH2 [open IOTEST2.TMP w]
    copyfile $testFH $testFH2
    close $testFH
    close $testFH2
    system "diff IOTEST.TMP IOTEST2.TMP >/dev/null 2>&1"
} 0 0

Test filecmds-3.2 {copyfile tests} {
    set testFH [open IOTEST3.TMP w]
    set testFH2 [open IOTEST2.TMP w]
    set stat [list [catch {copyfile $testFH $testFH2} msg] \
                   [lrange $msg 1 end]]
    close $testFH
    close $testFH2
    set stat
} 0 {1 {wasn't opened for reading}}

Test filecmds-3.3 {copyfile tests} {
    set testFH [open IOTEST.TMP r]
    set testFH2 [open IOTEST2.TMP r]
    set stat [list [catch {copyfile $testFH $testFH2} msg] \
                   [lrange $msg 1 end]]
    close $testFH
    close $testFH2
    set stat
} 0 {1 {wasn't opened for writing}}

Test filecmds-3.4 {copyfile tests} {
    copyfile $testFH $testFH2
} 1 "file \"$testFH\" isn't open"

Test filecmds-3.5 {copyfile tests} {
    copyfile
} 1 {wrong # args: copyfile ?-bytes num|-maxbytes num? fromFileId toFileId}

foreach flag {-bytes -maxbytes} {
    Test filecmds-3.6.$flag {copyfile tests} {
        set copySize [expr ($testFileSize*2)/3]
        set testFH [open IOTEST.TMP r]
        set testFH2 [open IOTEST2.TMP w]
        copyfile $flag $copySize $testFH $testFH2
        close $testFH
        close $testFH2

        set testFH [open IOTEST.TMP r]
        set testData [read $testFH $copySize]
        close $testFH

        set testFH2 [open IOTEST2.TMP r]
        set testData2 [read $testFH2]
        close $testFH2

        list [expr [file size IOTEST2.TMP] == $copySize] \
             [string compare $testData $testData2]
    } 0 {1 0}

    catch {unset testData testData2}
}

set copySize [expr $testFileSize*2]

Test filecmds-3.7 {copyfile tests} {
    set testFH [open IOTEST.TMP r]
    set testFH2 [open IOTEST2.TMP w]
    set stat [catch {copyfile -bytes $copySize $testFH $testFH2} msg]
    close $testFH
    close $testFH2
    list $stat $msg
} 0 [list 1 \
          "premature EOF, $copySize bytes expected, $testFileSize bytes actually read"]

Test filecmds-3.7 {copyfile tests} {
    set testFH [open IOTEST.TMP r]
    set testFH2 [open IOTEST2.TMP w]
    set stat [catch {copyfile -maxbytes $copySize $testFH $testFH2} msg]
    close $testFH
    close $testFH2
    list $stat $msg
} 0 [list 0 $testFileSize]

pipe readPF writePF

flush stdout  ;# Not going to exec, must clean up the buffers.
flush stderr
set sonPid [fork]

if {$sonPid == 0} {
    for {set cnt 0} {$cnt < 50} {incr cnt} {
        Test filecmds-4.1 {pipe tests} {
            if {![gets $readPF msgBuf]} {
               set msgBuf "Premature eof on pipe"
            }
            set msgBuf
        } 0 [GenRec $cnt]
    }
    close $readPF
    exit 0
}

for {set cnt 0} {$cnt < 50} {incr cnt} {
    puts $writePF [GenRec $cnt]
}
flush $writePF
Test filecmds-4.2 {pipe tests} {
    wait $sonPid
} 0 "$sonPid EXIT 0"

close $readPF
close $writePF

Test filecmds-5.1 {frename tests} {
    frename
} 1 {wrong # args: frename oldPath newPath}

Test filecmds-5.2 {frename tests} {
    frename a b c
} 1 {wrong # args: frename oldPath newPath}

Test filecmds-5.3 {frename tests} {
    frename IOTEST.TMP IOTEST4.TMP
    file exists IOTEST4.TMP
} 0 1

Test filecmds-5.4 {frename tests} {
    unlink -nocomplain IOTEST5.TMP
    list [catch {frename IOTEST5.TMP IOTEST6.TMP} msg] [string tolower $msg]
} 0 {1 {rename "iotest5.tmp" to "iotest6.tmp" failed: no such file or directory}}

Test filecmds-6.1 {readdir tests} {
    readdir
} 1 {wrong # args: readdir dirPath}

Test filecmds-6.2 {readdir tests} {
    readdir x y
} 1 {wrong # args: readdir dirPath}

tcltouch READDIR.TMP/AAA
tcltouch READDIR.TMP/BBB
tcltouch READDIR.TMP/CCC
tcltouch READDIR.TMP/DDD

Test filecmds-6.3 {readdir tests} {
    lsort [readdir READDIR.TMP]
} 0 {AAA BBB CCC DDD}

system {rm -rf *.TMP}